perm filename DSTO.F4[DRW,LCS] blob
sn#525289 filedate 1980-07-23 generic text, type T, neo UTF8
SUBROUTINE DSTO(LFT,JRT)
DIMENSION F(512),FF(512)
COMMON/D/ JD(4000),I(3,40000)
INTEGER X1,Y1,X2,Y2
DATA JFIRST/0/
IF(JFIRST.EQ.0)CALL RDFUNC(FF)
C ALWAYS USES SAME FUNC. AFTER 1ST TIME
JFIRST=-1
DO 799 K=1,512
799 F(K)=FF(K)
TYPE 199
ACCEPT 299,MA
IF(MA.EQ.' ')MA='M'
199 FORMAT(' ADD OR MULTIPLY '$)
299 FORMAT(A1)
IF(MA.EQ.'M')GO TO 399
TYPE 499
ACCEPT 599,ADD
DO 699 K=1,512
699 F(K)=F(K)*ADD
499 FORMAT(' ADD HOW MUCH? '$)
599 FORMAT(F)
399 W=JRT-LFT
N=0
JDONE=0
1 N=N+1
IF(I(3,N))GO TO 2
Z=(I(1,N)-LFT)/W
L=511.*Z+1.5
A=I(2,N)
IF(MA.EQ.'M')GO TO 3
I(2,N)=A+F(L)
GO TO 1
3 I(2,N)=A*F(L)
GO TO 1
2 RETURN
CCC2 N=1
M=-1
MY=-1
X1=I(1,N)
Y1=I(2,N)
GO TO 10
11 RX=0
17 X1=X2
Y1=Y2
10 N=N+1
IF(I(3,N).GE.0)GO TO 19
IF(M.AND.MY)RETURN
JDONE=-1
GO TO 15
19 X2=I(1,N)
Y2=I(2,N)
IF(I(3,N).EQ.0)GO TO 14
IF(MY.GT.0)GO TO 330
IF(M)GO TO 11
GO TO 15
14 IF(M.GT.0)GO TO 230
IF(Y1.NE.Y2)GO TO 130
IF(MY)MY=N
GO TO 10
330 M=MY
GO TO 15
130 IF(MY.GT.0)GO TO 330
230 IF(X1.NE.X2)GO TO 13
IF(M)M=N
GO TO 10
13 IF(M)GO TO 11
15 L=N-2
530 IF(L-M.LE.0)GO TO 18
DO 430 K=M,L
430 I(3,K)=2
18 M=-1
MY=-1
GO TO 11
C13 Z=X2-X1
C R=Y2-Y1
C R=Z/R
C CHECK FOR SAME ANGLE
C IF(R.EQ.RX)GO TO 16
C IF(M.GT.0)GO TO 15
C RX=R
C GO TO 17
C16 IF(M)M=N
C GO TO 17
END